perm filename KSIG.OLD[XX,LCS] blob
sn#208660 filedate 1976-03-28 generic text, type T, neo UTF8
00100 TITLE KSIG ; 00100 SUBROUTINE KSIG
00200 ENTRY KSIG
00300 EXTERNAL .COMM.,STF,CENTX,NOTWRT,IFIX
00400 KSIG: 0 ; FOR KEY SIGNATURES AND ACCENTS, ETC. (IN 'SCORE')
00500 ;00300 COMMON R2,JA,CENTR,J2,RJQ(20),JQ(17),T,Z,H/STF/RSTFAC(-3/4),RSTJ2
00600 ;00400 C*******************;;;; Z WIPED OUT IN NOTWRT!!! BE CAREFUL WITH S!!!
00700 ;00500 EQUIVALENCE (R4,RJQ(2)),(J4,JQ(2)),(J5,JQ(3)),(J6,JQ(4))
00800 ;00600 1,(R6,RJQ(4))
01000 MOVEI 02,11 ; JA=9
01100 MOVEM 2,.COMM.+1 ; C USES THIS KEY NUM IN NOTWRT
01300 ; COUNTER -- IZ=IABS(J5)
01400 MOVM 15,.COMM.+=26 ; NUMBER OF CALLS ON NOTWRT
01600 ; 01300 C THE CLEF NUM. IT GETS WIPED OUT IN NOTWRT.
01700 ; 01400 JW=1
01800 MOVEI 2,1
02000 ; 01500 R6=0
02100 SETZM .COMM.+7
02200 ; 01600 IF(J5.GT.0)JW=2
02300 SKIPLE .COMM.+=26
02400 AOS 2 ; 01700 C THE CODE FOR FLAT OR SHARP
02500 CAIGE 15,144 ; 01800 IF(IZ.LT.100)GO TO 5333
02600 JRST KS1
02700 MOVEI 2,3 ; 01900 JW=3
02900 SUBI 15,144 ; 02000 IZ=IZ-100
03000 ; 2100 WILL MAKE NATURALS IF 100 IS ADDED OR SUBTRACTED.
03100 ; 02200 5333 CLEF=-(J6+1)
03110 KS1: MOVEM 2,JW#
03200 MOVNI 04,1
03300 SUB 04,.COMM.+=27
03400 TLC 4,232000 ; 4 IS CLEF
03500 FADR 4,4
03600 MOVEM 4,CLEF# ;CLEF #S ARE CHNGD TO -1,-2,-3,-4 (TREB.,BA.,ALT.,TEN.)
03700 ; 02400 C CLEF NOW SET IN MAIN PROG.
03800 ; 02500 C IF NO CLEF GIVEN, TREBLE IS USED.
03900 ; 02600 T=10.
04000 MOVSI 13,204500 ; 13 IS T
04100 ; 02700 IF(CLEF.LT.-2.)T=11.
04200 CAMGE 4,[-2.0]
04300 MOVSI 13,204540
04310 MOVEM 13,T#
04500 MOVSI 2,203400 ; 02800 S=CLEF+4.
04600 FADR 2,4
04700 CAMN 4,[-4.0] ; 02900 IF(CLEF.EQ.-4)S=-1.
04800 MOVSI 02,576400
04900 MOVEM 02,S#
05000 ; 03000 IF(J5.LT.0)GO TO 253
05100 MOVE 02,.COMM.+=26
05200 JUMPL 02,KS2
05300 ; 03100 W=-3.
05400 MOVN 02,[3.0]
05500 ; 03200 YY=4.
05600 MOVSI 3,203400
05700 ; 03300 Z=11.
05800 MOVSI 4,204540 ; 03400 C SHARPS
05900 ; 03500 GO TO 353
06000 JRST KS3
06100 ; 03600 253 W=3.
06200 KS2: MOVSI 02,202600
06300 ; 03700 YY=-4.
06400 MOVN 3,[4.0]
06500 ; 03800 Z=7.
06600 MOVSI 4,203700 ; 03900 C FLATS
06700 KS3: MOVEM 2,W# ; 04000 353 N=1
06800 MOVEM 3,YY#
06900 MOVEM 4,Z#
07000 MOVEI 2,1
07100 MOVEM 02,N#
07200 ; 04100 Z=Z+R4
07300 MOVE 02,.COMM.+5
07400 FADRM 02,Z
07500 ; 04200 RX=JQ(1)
07600 MOVE 1,.COMM.+=24
07700 TLC 1,232000
07800 FADR 1,1
07900 MOVEM 1,RX#
08000 ; 04300 RA=0
08100 SETZM RA#
08200 ; 04400 C RA IS AMOUNT TO BE ADDED TO ORIGINAL POS.
08300 MOVEM 15,IZ# ; 04500 DO 553 KA=1,IZ
08400 MOVEI 15,1
08500 ; 04600 J5=JW
08600 KS6: MOVE 02,JW
08700 MOVEM 02,.COMM.+=26
08800 ; 04700 RJQ(1)=RX+RA
08900 MOVE 02,RX
09000 FADR 02,RA
09100 MOVEM 02,.COMM.+4
09200 ; 04800 RA=RA+13.*RSTJ2
09300 MOVSI 02,204640
09400 FMPR 02,STF+=8
09500 FADRM 02,RA ; 04900 C MOVES OVER FOR NEXT ACCI.
09600 ; 05000 RD=Z
09700 MOVE 02,Z
09800 MOVEM 02,RD#
09900 ; 05100 R4=Z
10000 MOVEM 02,.COMM.+5
10100 MOVN 2,CLEF ; 05200 IF(CLEF.NE.-1.)GO TO 7
10300 CAME 2,[1.0]
10400 JRST KS7
10500 ; 05300 IF(R4.GT.12.)R4=R4-7.
10600 MOVSI 02,204600
10700 CAML 02,.COMM.+5
10800 JRST KS9
10900 MOVN 02,[7.0]
11000 FADRM 02,.COMM.+5
11100 ; 05400 GO TO 9
11200 JRST KS9
11300 ; 05500 7 R4=R4-S
11400 KS7: MOVN 02,S
11500 FADRB 02,.COMM.+5
11600 CAMG 2,T ; 05600 IF(R4.GT.T)R4=R4-7.
11700 JRST KS9
11800 MOVN 02,[7.0]
11900 FADRM 02,.COMM.+5 ;5700 ABOVE ARRANGES VERT. POS OF ACCIS.
12000 ; 05800 9 J4=R4
12100 KS9: JSA 16,IFIX
12200 JUMP .COMM.+5
12300 MOVEM 00,.COMM.+=25
12400 ; 05900 C FOR VERT. POS. IN 'DRWNT' (WHEN PLOTTING.)
12500 ; 06000 CALL CENTX
12600 JSA 16,CENTX
12700 ; 06100 CALL NOTWRT
12800 JSA 16,NOTWRT
12900 ; 06200 Z=RD+W
13000 MOVE 02,W
13100 FADR 02,RD
13200 MOVEM 02,Z
13300 ; 06300 IF(N)Z=RD+YY
13400 MOVE 02,N
13500 JUMPGE 02,.+4
13600 MOVE 02,YY
13700 FADR 02,RD
13800 MOVEM 02,Z
13900 ; 06400 553 N=-N
14000 MOVNS 00,N
14100 CAMGE 15,IZ
14200 AOJA 15,KS6
14300 JRA 16,(16) ; 06500 END
14400 END